{
    This file is part of the Free Pascal run time library.
    Copyright (c) 2006 by Florian Klaempfl
    member of the Free Pascal development team.

    System unit for embedded systems

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}

Unit System;

{*****************************************************************************}
                                    interface
{*****************************************************************************}

{$undef MSWINDOWS}
{$undef UNIX}

{$define FPC_IS_SYSTEM}
{$define HAS_CMDLINE}
{$define USE_NOTHREADMANAGER}

{$I check.inc}

{$I systemh.inc}

{$ifdef FPC_HAS_FEATURE_TEXTIO}
const
  LineEnding = #10;
{$endif FPC_HAS_FEATURE_TEXTIO}
{$ifdef FPC_HAS_FEATURE_FILEIO}
const
  LFNSupport = true;
  DirectorySeparator = '/';
  DriveSeparator = ':';
  ExtensionSeparator = '.';
  PathSeparator = ';';
  AllowDirectorySeparators : set of char = ['\','/'];
  AllowDriveSeparators : set of char = [':'];
{$endif FPC_HAS_FEATURE_FILEIO}

{ FileNameCaseSensitive is defined below! }

{$ifdef FPC_HAS_FEATURE_EXITCODE}
const
  maxExitCode = 255;
{$endif FPC_HAS_FEATURE_EXITCODE}
{$ifdef FPC_HAS_FEATURE_FILEIO}
const

  MaxPathLen = 1024; // BSDs since 1993, Solaris 10, Darwin
  AllFilesMask = '*';

  UnusedHandle    = -1;
  StdInputHandle  : THandle= -1;
  StdOutputHandle : THandle= -1;
  StdErrorHandle  : THandle= -1;

  FileNameCaseSensitive : boolean = true;
{$endif FPC_HAS_FEATURE_FILEIO}
{$ifdef FPC_HAS_FEATURE_TEXTIO}
const
  CtrlZMarksEOF: boolean = false; (* #26 not considered as end of file *)

  sLineBreak = LineEnding;
  DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCrLF;
{$endif FPC_HAS_FEATURE_TEXTIO}

var
  argc:longint = 0;
  argv:PPchar = nil;
  
  envp:PPchar = nil;

{$ifdef FPC_HAS_FEATURE_COMMANDARGS}
function get_cmdline:Pchar;
property cmdline:Pchar read get_cmdline;
{$endif FPC_HAS_FEATURE_COMMANDARGS}

{$ifdef FPC_HAS_FEATURE_SOFTFPU}

{$define fpc_softfpu_interface}
{$i softfpu.pp}
{$undef fpc_softfpu_interface}

{$endif FPC_HAS_FEATURE_SOFTFPU}

{*****************************************************************************}
                                 implementation
{*****************************************************************************}

{ Include ELF resources }

const calculated_cmdline:Pchar=nil;

{$ifdef FPC_HAS_FEATURE_SOFTFPU}

{$define fpc_softfpu_implementation}
{$i softfpu.pp}
{$undef fpc_softfpu_implementation}

{ we get these functions and types from the softfpu code }
{$define FPC_SYSTEM_HAS_float64}
{$define FPC_SYSTEM_HAS_float32}
{$define FPC_SYSTEM_HAS_flag}
{$define FPC_SYSTEM_HAS_extractFloat64Frac0}
{$define FPC_SYSTEM_HAS_extractFloat64Frac1}
{$define FPC_SYSTEM_HAS_extractFloat64Exp}
{$define FPC_SYSTEM_HAS_extractFloat64Frac}
{$define FPC_SYSTEM_HAS_extractFloat64Sign}
{$define FPC_SYSTEM_HAS_ExtractFloat32Frac}
{$define FPC_SYSTEM_HAS_extractFloat32Exp}
{$define FPC_SYSTEM_HAS_extractFloat32Sign}

{$endif FPC_HAS_FEATURE_SOFTFPU}

{$I system.inc}

{*****************************************************************************
                       Misc. System Dependent Functions
*****************************************************************************}

procedure System_exit;
begin
	while true do;
End;     

procedure PascalMain;stdcall;external name 'PASCALMAIN';

procedure Exe_Entry; {nostackframe;}[public, alias: 'ExecEntry'];
var i: longint;
begin
   //IsLibrary:=false;
	for i := 0 to 80*25-1 do pchar($b8000+i*2)^ := '!';
	while true do;
	//PascalMain;
end;

procedure Lib_Entry; nostackframe; [public, alias: 'LibraryEntry'];
begin
   IsLibrary:=true;
	//PascalMain;
end;

{$ifdef FPC_HAS_FEATURE_RANDOM}

Procedure Randomize;
Begin
  //randseed:=longint(Fptime(nil));
End;

{$endif FPC_HAS_FEATURE_RANDOM}


{$ifdef FPC_HAS_FEATURE_PROCESSES}
function GetProcessID: SizeUInt;
begin
   GetProcessID := 0;
end;
{$endif}

{$ifdef FPC_HAS_FEATURE_COMMANDARGS}

Function ParamCount: Longint;
Begin
   Paramcount:=argc
End;

function paramstr(l: longint) : string;
begin
   if (l >= 0) and (l < argc) then
      paramstr := argv[l]
   else
      paramstr := '';
end;

{*****************************************************************************
                                    cmdline
*****************************************************************************}

procedure SetupCmdLine;
var len: PtrInt;
    arglen,
    count   : longint;
    argstart,
    pc,arg  : pchar;
    quote   : char;
    argvlen : longint;
    buf: array[0..259] of char;  // need MAX_PATH bytes, not 256!

  procedure allocarg(idx,len:longint);
    var
      oldargvlen : longint;
    begin
      if idx>=argvlen then
       begin
         oldargvlen:=argvlen;
         argvlen:=(idx+8) and (not 7);
         sysreallocmem(argv,argvlen*sizeof(pointer));
         fillchar(argv[oldargvlen],(argvlen-oldargvlen)*sizeof(pointer),0);
       end;
      { use realloc to reuse already existing memory }
      { always allocate, even if length is zero, since }
      { the arg. is still present!                     }
      sysreallocmem(argv[idx],len+1);
    end;

begin
   if assigned(calculated_cmdline) then
      exit;
   
   count:=0;
   argv:=nil;
   argvlen:=0;
   
   len := GetArgsize;
   
   if len <= 0 then
      len := 0;
   
   calculated_cmdline := GetMem(len+1);
   GetArgs(calculated_cmdline, len);
   calculated_cmdline[len] := #0;
   
   // set up exe name
   arglen := GetAppName(@buf[0], 259);
   buf[arglen] := #0;
   allocarg(0,arglen);
   move(buf,argv[0]^,arglen+1);
   
   inc(count);
   
   pc := calculated_cmdline;
   
   while pc^<>#0 do
   begin
      { skip leading spaces }
      while pc^ in [#1..#32] do
         inc(pc);
      if pc^=#0 then
         break;
      { calc argument length }
      quote:=' ';
      argstart:=pc;
      arglen:=0;
      while (pc^<>#0) do
      begin
         case pc^ of
            #1..#32 :
               begin
                  if quote<>' ' then
                     inc(arglen)
                  else
                     break;
               end;
            '"' :
               begin
                  if quote<>'''' then
                  begin
                     if pchar(pc+1)^<>'"' then
                     begin
                        if quote='"' then
                           quote:=' '
                        else
                           quote:='"';
                     end
                     else
                        inc(pc);
                  end
                  else
                     inc(arglen);
               end;
            '''' :
               begin
                  if quote<>'"' then
                  begin
                     if pchar(pc+1)^<>'''' then
                     begin
                        if quote=''''  then
                           quote:=' '
                        else
                           quote:='''';
                     end
                     else
                        inc(pc);
                  end
                  else
                     inc(arglen);
               end;
            else
               inc(arglen);
         end;
         inc(pc);
      end;
      
      { copy argument }
      { Don't copy the first one, it is already there.}
      If Count<>0 then
      begin
         allocarg(count,arglen);
         quote:=' ';
         pc:=argstart;
         arg:=argv[count];
         while (pc^<>#0) do
         begin
            case pc^ of
               #1..#32 :
                  begin
                     if quote<>' ' then
                     begin
                        arg^:=pc^;
                        inc(arg);
                     end
                     else
                        break;
                  end;
               '"' :
                  begin
                     if quote<>'''' then
                     begin
                        if pchar(pc+1)^<>'"' then
                        begin
                           if quote='"' then
                              quote:=' '
                           else
                              quote:='"';
                        end
                        else
                           inc(pc);
                     end
                     else
                     begin
                        arg^:=pc^;
                        inc(arg);
                     end;
                  end;
               '''' :
                  begin
                     if quote<>'"' then
                     begin
                        if pchar(pc+1)^<>'''' then
                        begin
                           if quote=''''  then
                              quote:=' '
                           else
                              quote:='''';
                        end
                        else
                           inc(pc);
                     end
                     else
                     begin
                        arg^:=pc^;
                        inc(arg);
                     end;
                  end;
               else
                  begin
                     arg^:=pc^;
                     inc(arg);
                  end;
            end;
            inc(pc);
         end;
         arg^:=#0;
      end;
      inc(count);
   end;
   { get argc }
   argc:=count;
   { free unused memory, leaving a nil entry at the end }
   sysreallocmem(argv,(count+1)*sizeof(pointer));
   argv[count] := nil;
end;

function get_cmdline:Pchar;
begin
  if calculated_cmdline=nil then
    setupcmdline;
  get_cmdline:=calculated_cmdline;
end;

{$endif FPC_HAS_FEATURE_COMMANDARGS}


{*****************************************************************************
                         SystemUnit Initialization
*****************************************************************************}

{$ifdef FPC_HAS_FEATURE_STACKCHECK}

function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
begin
	result := 0;
end;

var
  initialstkptr : Pointer;

{$endif FPC_HAS_FEATURE_STACKCHECK}

{$ifdef FPC_HAS_FEATURE_CONSOLEIO}
procedure SysInitStdIO;
begin
   StdInputHandle := GetStdInput;
   StdOutputHandle := GetStdOutput;
   StdErrorHandle := GetStdError;
   
	OpenStdIO(Output,   fmOutput,StdOutputHandle);
	OpenStdIO(Input,    fmInput, StdInputHandle);
	OpenStdIO(StdOut,   fmOutput,StdOutputHandle);
	OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
	OpenStdIO(StdErr,   fmOutput,StdErrorHandle);
end;
{$endif FPC_HAS_FEATURE_CONSOLEIO}


begin
{$ifdef FPC_HAS_FEATURE_FPU}
  SysResetFPU;
  if not(IsLibrary) then
    SysInitFPU;
{$endif FPC_HAS_FEATURE_FPU}

{$ifdef FPC_HAS_FEATURE_CONSOLEIO}
  IsConsole := TRUE;
{$endif FPC_HAS_FEATURE_CONSOLEIO}

{$ifdef FPC_HAS_FEATURE_STACKCHECK}
  StackLength := CheckInitialStkLen($1000);
  StackBottom := initialstkptr - StackLength;
{$endif FPC_HAS_FEATURE_STACKCHECK}

{$ifdef FPC_HAS_FEATURE_HEAP}
  { Setup heap }
  InitHeap;
{$endif FPC_HAS_FEATURE_HEAP}

{$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
  SysInitExceptions;
{$endif FPC_HAS_FEATURE_EXCEPTIONS}


{$ifdef FPC_HAS_FEATURE_CONSOLEIO}
  { Setup stdin, stdout and stderr }
  SysInitStdIO;
{$endif FPC_HAS_FEATURE_CONSOLEIO}

{$ifdef FPC_HAS_FEATURE_COMMANDARGS}
  { Arguments }
  SetupCmdLine;
{$endif FPC_HAS_FEATURE_COMMANDARGS}

{$ifdef FPC_HAS_FEATURE_CONSOLEIO}
  { Reset IO Error }
  InOutRes:=0;
{$endif FPC_HAS_FEATURE_CONSOLEIO}

{$ifdef FPC_HAS_FEATURE_THREADING}
  { threading }
  InitSystemThreads;
{$endif FPC_HAS_FEATURE_THREADING}

{$ifdef FPC_HAS_FEATURE_VARIANTS}
  initvariantmanager;
{$endif FPC_HAS_FEATURE_VARIANTS}

{$ifdef VER2_2}
  //initwidestringmanager;
{$else VER2_2}
  //initunicodestringmanager;
{$endif VER2_2}
end.
